home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / w3-srch.el < prev    next >
Encoding:
Text File  |  1995-07-08  |  6.8 KB  |  189 lines
  1. ;;; w3-srch.el,v --- Searching functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/06/25 01:00:09
  4. ;; Version: 1.11
  5. ;; Keywords: matching, help, comm, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
  9. ;;;
  10. ;;; This file is part of GNU Emacs.
  11. ;;;
  12. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;;; it under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 2, or (at your option)
  15. ;;; any later version.
  16. ;;;
  17. ;;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; You should have received a copy of the GNU General Public License
  23. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.  
  27. (defvar w3-allow-searching-of
  28.   '("text/plain" "text/html" "text/x-setext"
  29.     "application/x-troff-man" "application/x-troff-me"
  30.     "application/x-troff-ms" "application/rtf"
  31.     "text/richtext" "application/x-wais-source"
  32.     "application/tex" "application/texinfo"
  33.     "application/x-troff")
  34.   "*A list of MIME content types that it is Ok for the automatic
  35. search to descend to.")
  36.  
  37. (defun w3-do-search (term &optional base hops-limit restriction)
  38.   "Recursively descend all the child links of the current document for TERM.
  39. TERM may be a string, in which case it is treated as a regular expression,
  40. and re-search-forward is used, or a symbol, in which case it is funcalled
  41. with 1 argument, the current URL being searched.
  42.  
  43. BASE is the URL to start searching from.
  44.  
  45. HOPS-LIMIT is the maximum number of nodes to descend before they
  46. search dies out.
  47.  
  48. RESTRICTION is a regular expression or function to call with one
  49. argument, a URL that could be searched.  If RESTRICTION returns
  50. non-nil, then the url is added to the queue, otherwise it is
  51. discarded.  This is useful for restricting searching to either
  52. certain tyes of URLs (only search ftp links), or restricting searching
  53. to one domain (only search stuff in the indiana.edu domain).
  54.  
  55. For use in functions passed to w3-do-search:
  56. QUEUE is the queue of links to be searched
  57. HOPS is the current number of hops from the root document
  58. RESULTS is an assoc list of (URL . RETVAL), where RETVAL is the value
  59. returned from previous calls to the TERM function (or point if searching
  60. for a regexp"
  61.   (let ((x))
  62.     (or base (setq base (url-view-url t)))
  63.     (if (setq x (url-buffer-visiting base))
  64.     (set-buffer x)
  65.       (w3-fetch base))
  66.     (w3-search-internal term hops-limit restriction)))
  67.  
  68. (defun w3-normalize-url (url)
  69.   "Normalize a URL, removing all '#' references from it, etc."
  70.   (cond
  71.    ((null url) nil)
  72.    ((string-match "#\\(.*\\)" url) (url-match url 1))
  73.    (t url)))
  74.   
  75. (defun w3-search-internal (term &optional hops-limit restriction)
  76.   "Recursively descend all the child links of the current document for TERM.
  77. TERM may be a string, in which case it is treated as a regular expression,
  78. and re-search-forward is used, or a symbol, in which case it is funcalled
  79. with 1 argument, the current URL being searched.
  80.  
  81. HOPS-LIMIT is the maximum number of nodes to descend before they
  82. search dies out.
  83.  
  84. RESTRICTION is a regular expression or function to call with one
  85. argument, a URL that could be searched.  If RESTRICTION returns
  86. non-nil, then the url is added to the queue, otherwise it is
  87. discarded.  This is useful for restricting searching to either
  88. certain tyes of URLs (only search ftp links), or restricting searching
  89. to one domain (only search stuff in the indiana.edu domain).
  90.  
  91. For use in functions passed to w3-do-search:
  92. QUEUE is the queue of links to be searched
  93. HOPS is the current number of hops from the root document
  94. RESULTS is an assoc list of (URL . RETVAL), where RETVAL is the value
  95. returned from previous calls to the TERM function (or point if searching
  96. for a regexp"
  97.   (setq hops-limit (or hops-limit 5))
  98.   (let ((queue '())
  99.     (visited '())
  100.     (results nil)
  101.     (hops 0))
  102.  
  103.     ;; Search initial page and stick it in the results list
  104.     (goto-char (point-min))
  105.     (cond
  106.      ((stringp term)
  107.       (setq results (cons (url-view-url t) (re-search-forward term nil t))))
  108.      ((symbolp term)
  109.       (setq results (cons (url-view-url t) (funcall term (url-view-url t))))))
  110.  
  111.     ;; Build the initial queue of just the links on this page that are
  112.     ;; deemed searchable
  113.     (w3-map-links
  114.      (function
  115.       (lambda (x st nd y)
  116.     (if (and
  117.          (member (nth 8 (url-file-attributes (nth 2 x)))
  118.             w3-allow-searching-of)
  119.          (cond
  120.           ((null (nth 2 x)) nil)
  121.           ((stringp restriction) (string-match restriction (nth 2 x)))
  122.           ((symbolp restriction) (funcall restriction (nth 2 x)))
  123.           (t t)))
  124.         (setq queue (nconc queue (list (w3-normalize-url (nth 2 x)))))))))
  125.  
  126.     (while queue
  127.       (let ((x (car queue)) y)
  128.     (setq visited (cons x visited))
  129.     (if (setq y (url-buffer-visiting x))
  130.         (set-buffer y)
  131.       (url-retrieve x))
  132.     (cond
  133.      ((equal (or url-current-mime-type
  134.              (mm-extension-to-mime (w3-file-extension
  135.                         url-current-file))) "text/html")
  136.       (w3-prepare-buffer t)
  137.       (w3-map-links
  138.        (function
  139.         (lambda (link-data st nd searching-func)
  140.           (let* ((url (w3-normalize-url (nth 2 link-data)))
  141.              (info (and
  142.                 (cond
  143.                  ((null url) nil)
  144.                  ((stringp restriction)
  145.                   (string-match restriction url))
  146.                  ((symbolp restriction)
  147.                   (funcall restriction url))
  148.                  (t t))
  149.                 (url-file-attributes url)))
  150.              (num-children 0))
  151.         (cond
  152.          ((null info)
  153.           (message "Skipping %s (not searchable)" url) nil)
  154.          ((member (nth 8 info) w3-allow-searching-of)
  155.           (if (< hops hops-limit)
  156.               (w3-map-links    ; Count the child links
  157.                (function    ; and add them to the queue to 
  158.             (lambda (lnk st nd arg) ; be serviced
  159.               (setq num-children (1+ num-children))
  160.               (if (or
  161.                    (member url visited)     ; already seen it
  162.                    (member url queue))     ; planning on seeing it
  163.                   nil
  164.                 (setq queue (nconc queue (list url))))))))
  165.           (goto-char (point-min))
  166.           (cond
  167.            ((stringp term)
  168.             (setq results (cons (cons url
  169.                           (re-search-forward term nil t))
  170.                     results)))
  171.            ((symbolp term)
  172.             (setq results (cons (cons url (funcall term url))
  173.                     results)))
  174.            (t
  175.             (error "TERM must be a regular expression or symbol."))))
  176.          (t (message "Skipping %s (why?)" url))))))))
  177.      (t
  178.       (goto-char (point-min))
  179.       (cond
  180.        ((stringp term)
  181.         (setq results (cons (cons x (re-search-forward term nil t))
  182.                 results)))
  183.        ((symbolp term)
  184.         (setq results (cons (cons x (funcall term x)) results)))))))
  185.       (setq queue (cdr queue)))
  186.     results))
  187.  
  188. (provide 'w3-srch)
  189.